perm filename HOL.SAI[2,DBL] blob
sn#024248 filedate 1973-02-12 generic text, type T, neo UTF8
00100 BEGIN "MAIN"
00200 REQUIRE "HELIB[1,3]" LIBRARY;
00300 INTEGER ARRAY OBJECT[1:50,1:4];
00400 INTEGER ARRAY BUF[1:10000];
00500 INTEGER ARRAY STORAGE[1:25];
00600 INTEGER PICNUM,NPTS,COUNT,BRCHAR,EXT,PPN,B,X,EOF,FLAG,Y,Z,Z2;
00700 INTEGER DX,XINIT,XFINAL,TOTX,NX,YINIT,YFINAL,TOTY,NY,DY;
00800 INTEGER LAMBDA,GREY2,GREY,X2,Y2,NP,SUM,VAL,A,C,A0,A2,A4,ARG2,ARG4;
00900 STRING FILE;
01000 EXTERNAL INTEGER BITS,TVWORD,RSIDE,LSIDE,FLINE,LLINE,IWID;
01100 BOOLEAN FAIL;
01200 EXTERNAL PROCEDURE INTPNT;
01300 EXTERNAL PROCEDURE ADJUST;
01400 EXTERNAL PROCEDURE PUTPNT (INTEGER X,Y,VAL);
01500 EXTERNAL PROCEDURE PICWR(INTEGER CHAN,FILE,EXT,PPN;
01600 REFERENCE BOOLEAN FAIL; INTEGER ARRAY STORAGE);
01700 EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY BUF);
01800 INTEGER PROCEDURE GETPAR;
01900 BEGIN
02000
02100 OPEN(2,"DSK",0,3,0,COUNT,BRCHAR,EOF);
02200 LOOKUP(2,"OBJ.1[2,DBL]",FLAG);
02300 OUTSTR("TYPE IN NPTS...");
02400 NPTS←CVD(INCHWL);
02500 FOR X←1 STEP 1 UNTIL NPTS DO
02600 FOR Y←1 STEP 1 UNTIL 4 DO
02700 OBJECT[X,Y] ← INTIN(2);
02800 CLOSE(2);
02900 FOR X←NPTS+1 STEP 1 UNTIL 50 DO
03000 FOR Y←1 STEP 1 UNTIL 4 DO
03100 OBJECT[X,Y]←0;
03200 OUTSTR("TYPE XINIT... ");
03300 XINIT←CVD(INCHWL);
03400 OUTSTR("TYPE XFINAL.. ");
03500 XFINAL←CVD(INCHWL);
03600 OUTSTR("TYPE DELTA-X.. ");
03700 DX←CVD(INCHWL);
03800 TOTX←XFINAL-XINIT;
03900 NX←(TOTX+DX-1)/DX;
04000 OUTSTR("THEN TOTAL-X IS "&CVS(TOTX)&" AND NX (THE LINE LENGTH) IS "
04100 &CVS(NX)&'15 & '12);
04200 OUTSTR("TYPE YINIT... ");
04300 YINIT←CVD(INCHWL);
04400 OUTSTR("TYPE YFINAL.. ");
04500 YFINAL←CVD(INCHWL);
04600 OUTSTR("TYPE DELTA-Y... ");
04700 DY←CVD(INCHWL);
04800 TOTY←YFINAL-YINIT;
04900 NY←(TOTY+DY-1)/DY;
05000 OUTSTR("THEN TOTAL-Y IS " & CVS(TOTY) &
05100 " AND NY (THE VERT. HEIGHT) IS " & CVS(NY) & '15 & '12);
05200 OUTSTR("TYPE LAMBDA (ACTUALLY, LAMBDA SQUARED /16 PI-SQUARED)... ");
05300 LAMBDA ← CVD(INCHWL);
05400 OUTSTR("TYPE THE LOG (BASE 2) OF THE GREY SCALE... ");
05500 BITS ← CVD(INCHWL);
05600 GREY ← 2↑BITS;
05700 GREY2 ← GREY / 2;
05800 A0 ←1000000;
05900 A2 ←-5000;
06000 A4 ←4;
06100 OUTSTR("THUS OUR GREY SCALE RANGES FROM 1 TO "&CVS(GREY)
06200 & '15 & '12);
06300 END;
06400
06500 INTEGER PROCEDURE INIT; BEGIN
06600 GETPAR;
06700 TVWORD ← GIOWD(BUF);
06800 RSIDE ← NX-1;
06900 LSIDE ← 0;
07000 FLINE ← 0;
07100 LLINE ← NY-1;
07200 IWID ← RSIDE - LSIDE + 1;
07300
07400
07500 FOR X ← 2 STEP 1 UNTIL 25 DO STORAGE[X]←0;
07600 STORAGE[1]←TVWORD+1;
07700
07800 ADJUST;
07900 INTPNT;
08000
08100 OUTSTR("TYPE IN THE PICTURE NUMBER....");
08200 PICNUM←CVD(INCHWL);
08300 FILE ← "H."&CVS(PICNUM)&"[2,DBL]";
08400 END;
08500
08600 INTEGER PROCEDURE COS2(INTEGER A,B,C);
08700 BEGIN
08800 ARG2 ← ((A*A) + (B*B) + (C*C)) / LAMBDA;
08803 VAL ← (ARG2↑0.5) MOD 314;
08806 IF VAL > 157 THEN VAL ← 314 - VAL;
08809 ARG2 ← VAL*VAL;
08900 ARG4 ← ARG2 * ARG2;
09000 VAL ← A0 + (A2*ARG2) + (A*ARG4);
09050 VAL ← ((GREY2*VAL)/A0) + GREY2;
09100 RETURN(VAL);
09200 END;
09300
09400
09500 INTEGER PROCEDURE GETVAL(INTEGER X,Y);
09600 BEGIN
09700 SUM ← 0;
09800 X2 ← XINIT + (DX*X);
09900 Y2 ← YINIT + (DY*Y);
10000 FOR NP← 1 STEP 1 UNTIL NPTS DO
10100 SUM ← SUM + (OBJECT[NP,4]*COS2((X2-OBJECT[NP,1]),
10200 (Y2-OBJECT[NP,2]), OBJECT[NP,3]));
10300 SUM ← (SUM MOD GREY2) + GREY2;
10400 RETURN(SUM);
10500 END;
10600
10700
10800 INIT;
10900 VAL←5;
11000 FOR X← LSIDE STEP 1 UNTIL RSIDE DO
11100 BEGIN
11200 OUTSTR(CVS(X)&" "&CVS(VAL)&" ");
11300 FOR Y ← FLINE STEP 1 UNTIL LLINE DO
11400 PUTPNT(X,Y,GETVAL(X,Y));
11500 END;
11600
11700 PICWR(1,CVFIL(FILE,EXT,PPN),EXT, PPN ,FAIL,STORAGE);
11800 OUTSTR("BUF HAS BEEN TRANSFERRED TO FILE " & FILE);
11900 OUTSTR(CVS(FAIL))
12000 END ;
12100